Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/magiccoo.i

Modula Implementation | 1997-10-26 | 5.3 KB | 158 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *         MAGIC   Modula's  All purpose  GEM  Interface  Cadre         *
 *                 ÿ         ÿ            ÿ    ÿ          ÿ             *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus in schrift-  *
 * licher Form, insbesondere in Zeitschriften, sowie die Verbreitung    *
 * ber Public-Domain-H„ndler bedarf der ausdrcklichen schriftlichen   *
 * Genehmigung des Autors!                                              *
 *                                                                      *
 * Der Autor gibt hiermit die ausdrckliche Erlaubnis, das Modul jeder- *
 * zeit auch im Quelltext weiterzugegeben, sofern dessen Text und ins-  *
 * besondere dieser Urheberrechts-Vermerk nicht ver„ndert wird, und     *
 * durch die Weitergabe kein finanzieller Nutzen entsteht. Der Autor    *
 * beh„lt sich das Recht vor, diese Erlaubnis jederzeit u. ohne Angaben *
 * von Grnden zu widerrufen.                                           *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE MagicCookie;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *  3.01     | 29.01.92 |  Hp  | Routinen optimiert                     *
 *-----------+----------+------+----------------------------------------*)



(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)






FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;






IMPORT SYSTEM;
IMPORT MagicDOS;

CONST MaxCookies = 1024; (* Mehr Cookies wird ja wohl keiner haben *)

TYPE tCookie =  RECORD
                 id:  lCARDINAL;
                 val: lWORD;
                END;

TYPE tJar =     POINTER TO ARRAY [0..MaxCookies] OF tCookie;

VAR  dummy:     RECORD
                 CASE : BOOLEAN OF
                  TRUE:  str: ARRAY [0..3] OF CHAR; (* Identifier *)|
                  FALSE: lc:  lCARDINAL;|
                 END;
                END;

 VAR Jar[05A0H]: tJar;




VAR stack: SYSTEM.ADDRESS;
    NoJar: SYSTEM.ADDRESS;

PROCEDURE FindCookie (cookie: ARRAY OF CHAR; VAR value: lWORD): BOOLEAN;
VAR p: tJar;
    (*$Reg*)  c: sCARDINAL;
    b: BOOLEAN;
BEGIN
 stack:= Null;  MagicDOS.Super (stack);  b:= FALSE;
 IF Jar # NoJar THEN
  FOR c:= 0 TO 3 DO  dummy.str[c]:= cookie[c];  END;
  p:= Jar;  c:= 0;
  WHILE (p^[c].id # 0) AND NOT b DO
   IF p^[c].id = dummy.lc THEN
    value:= p^[c].val;  b:= TRUE;
   END;
   INC (c);
  END;
 END;
 MagicDOS.Super (stack);
 RETURN b;
END FindCookie;

PROCEDURE ModifyCookie (cookie: ARRAY OF CHAR; newvalue: lWORD): BOOLEAN;
VAR p: tJar;
    (*$Reg*)  c: sCARDINAL;
    b: BOOLEAN;
BEGIN
 stack:= Null;  MagicDOS.Super (stack);  b:= FALSE;
 IF Jar # NoJar THEN
  FOR c:= 0 TO 3 DO  dummy.str[c]:= cookie[c];  END;
  p:= Jar;  c:= 0;
  WHILE (p^[c].id # 0) AND NOT b DO
   IF p^[c].id = dummy.lc THEN
    p^[c].val:= newvalue;  b:= TRUE;
   END;
   INC (c);
  END;
 END;
 MagicDOS.Super (stack);
 RETURN FALSE;
END ModifyCookie;

VAR p: tJar;
    cook: sCARDINAL;

PROCEDURE ListCookies (flag: Listmode; VAR id: ARRAY OF CHAR; VAR value: lWORD): BOOLEAN;
VAR (*$Reg*)  c: sCARDINAL;  ok: BOOLEAN;
BEGIN
 id[0]:= 0C;  c:= 0;  value:= CastToLWord (c);  ok:= FALSE;
 stack:= Null;  MagicDOS.Super (stack);
 IF Jar # NoJar THEN
  IF flag = first THEN  p:= Jar;  cook:= 0;  END;
  IF p^[cook].id # 0 THEN
   value:= p^[cook].val;  (* Den Cookie-Wert bertragen *)
   dummy.lc:= p^[cook].id;  (* den Longcard in einen String wandeln *)
   FOR c:= 0 TO 3 DO  id[c]:= dummy.str[c];  END;
   IF HIGH (id) > 3 THEN id[4]:= 0C;  END; (* Fr Terminierung sorgen *)
   INC (cook); (* N„chster Cookie *)
   ok:= TRUE;
  END;
 END;
 MagicDOS.Super (stack);
 RETURN ok;
END ListCookies;

BEGIN
 cook:= 0;

 NoJar:= 0;


END MagicCookie.